home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / wwiv.arc / PART1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-04-03  |  10.9 KB  |  315 lines
  1.  
  2.                       {*****************************}
  3.                       {Copyright (c) 1986 Wayne Bell}
  4.                       {*****************************}
  5.  
  6. procedure printfile1(fn:str; var abort:boolean);
  7. var fil:text;
  8.     i:str;
  9.     next:boolean;
  10. begin
  11.  if not hangup then begin
  12.   assign(fil,fn);
  13.   {$I-} reset(fil); {$I+}
  14.   if ioresult<>0 then print('File not found.') else begin
  15.     abort:=false;
  16.     while not eof(fil) and (not abort) and (not hangup) do begin
  17.       readln(fil,i);
  18.       printa(i,abort,next);
  19.     end;
  20.     close(fil);
  21.   end;
  22.   nl;nl;
  23.  end;
  24. end;
  25.  
  26. procedure printfile(fn:str);
  27. var fil:text;
  28.     i:str;
  29.     abort,next:boolean;
  30. begin
  31.  if not hangup then begin
  32.   assign(fil,fn);
  33.   {$I-} reset(fil); {$I+}
  34.   if ioresult<>0 then print('File not found.') else begin
  35.     abort:=false;
  36.     while not eof(fil) and (not abort) and (not hangup) do begin
  37.       readln(fil,i);
  38.       printacr(i,abort,next);
  39.     end;
  40.     close(fil);
  41.   end;
  42.   nl;nl;
  43.  end;
  44. end;
  45.  
  46. procedure inli(var i:str);
  47. var cp,rp:integer; c:char; cv,cc:integer;
  48. begin
  49.   rp:=1; cp:=1;
  50.   i:='';
  51.   if ll<>'' then begin prompt(ll); i:=ll; ll:=''; cp:=length(i)+1; rp:=cp;end;
  52.   repeat
  53.     getkey(c); skey(c);
  54.     case ord(c) of
  55.       32..126:if (cp<strlen) and (rp<thisuser.linelen) then begin
  56.                 i[cp]:=c; cp:=cp+1; rp:=rp+1; outkey(c); thisline:=thisline+c;
  57.               end;
  58.             127,8:if cp>1 then begin c:=chr(8);
  59.                 if i[cp-1]=chr(8) then begin prompt(' '); rp:=rp+1; end else
  60.                  if i[cp-1]<>chr(10) then
  61.                    begin prompt(c+' '+c); rp:=rp-1; end;
  62.                 cp:=cp-1;
  63.               end;
  64.            24:begin
  65.                 cp:=1; for cv:=1 to rp-1 do prompt(chr(8)+' '+chr(8));
  66.                 rp:=1;
  67.               end;
  68.            23:if cp>1 then repeat
  69.                 prompt(chr(8)+' '+chr(8)); rp:=rp-1; cp:=cp-1;
  70.               until (cp=1) or (i[cp]=' ') or (i[cp]=chr(8));
  71.            14:if (not (rbackspace in thisuser.ac)) and (rp>1) and (cp<strlen) then begin
  72.                 prompt(chr(8)); i[cp]:=chr(8); cp:=cp+1; rp:=rp-1;
  73.               end;
  74.            10:if (not (rbackspace in thisuser.ac)) and (cp<strlen) then begin
  75.                 prompt(c); i[cp]:=c; cp:=cp+1;
  76.               end;
  77.             9:begin
  78.                 cv:=5-(cp mod 5); if (cp+cv<strlen) and (rp+cv<thisuser.linelen) then
  79.                   for cc:=1 to cv do begin
  80.                     rp:=rp+1; prompt(' ');
  81.                     i[cp]:=' '; cp:=cp+1;
  82.                   end;
  83.               end;
  84.   end;
  85.   until (c=chr(13)) or ((rp=thisuser.linelen) and (wordwrap in thisuser.defaults)) or hangup;
  86.   i[0]:=chr(cp-1);
  87.   if c<>chr(13) then begin
  88.     cv:=cp-1;
  89.     while (cv>0) and (i[cv]<>' ') and (i[cv]<>chr(8))do cv:=cv-1;
  90.     if (cv>(rp div 2)) and (cv<>cp-1) then begin
  91.       ll:=copy(i,cv+1,cp-cv); for cc:=cp-2 downto cv do prompt(chr(8));
  92.       for cc:=cp-2 downto cv do prompt(' ');
  93.       i[0]:=chr(cv-1);
  94.     end;
  95.   end;
  96.   nl;
  97.   if c=chr(13) then i:=i+chr(1);
  98. end;
  99.  
  100. function filename(mrec:messages):str;
  101. begin
  102.   filename:='msgs\'+mrec.ltr+cstr(mrec.number)+'.'+cstr(mrec.ext);
  103. end;
  104.  
  105. procedure inmsg(var mrec:messages;an:anontyp;var title:str;tr,mp:boolean);
  106. var li:array[1..75] of str; t1,t,maxli,lc:integer; filler,spc,ti,i:str;
  107. saveline,exit,save,abortit:boolean; c:char; filvar:text;
  108.  
  109.   procedure listit(linenum:boolean);
  110.   var l:integer; abort,next:boolean;
  111.   begin
  112.     l:=1;
  113.     abort:=false;
  114.     while (l<>lc) and (not abort) do begin
  115.       if linenum then print(cstr(l)+':');
  116.       printa(li[l],abort,next);
  117.       if pap<>0 then nl;
  118.       l:=l+1;
  119.     end;
  120.     print('---===> Total lines: '+cstr(lc-1));
  121.     saveline:=false;
  122.   end;
  123.  
  124. begin
  125.  if freek>10 then begin
  126.   helpl:='F';lc:=1;spc:='                                                                              ';
  127.   filler:='-------------------------------------------------------------------------------';
  128.   ll:=''; if thisuser.sl<45 then maxli:=30 else if thisuser.sl<60 then
  129.     maxli:=50 else if thisuser.sl<80 then maxli:=60 else maxli:=75;
  130.   if tr then begin
  131.     repeat
  132.       print('       (---=----=----=----=----=----)');
  133.       prompt('Title? '); inputl(title,30);
  134.       if title<>'' then begin prompt('Ok? '); c:='N'; if yn then c:='Y'; end else c:='Y';
  135.     until (c='Y') or hangup;
  136.   end else begin
  137.     print('       (---=----=----=----=----=----)');
  138.     prompt('Title? '); inputl(title,30);
  139.   end;
  140.  end else begin
  141.    title:=''; tr:=true;
  142.    print('Not enough disk space');
  143.  end;
  144.  if (title<>'') or not tr then begin
  145.   print('Enter message now, max '+cstr(maxli)+' lines.');
  146.   print('Enter "/HELP" for help');
  147.   print(copy('[---=----=----=----=----=----=----=----]----=----=----=----=----=----=----=----]',
  148.     1,thisuser.linelen));
  149.  repeat
  150.   repeat
  151.     saveline:=true; exit:=false; save:=false; abortit:=false;
  152.     inli(i); ti:=copy(i,1,3);
  153.     ti[1]:=upcase(ti[1]); ti[2]:=upcase(ti[2]); ti[3]:=upcase(ti[3]);
  154.     if (ti='/RL') and (lc>1) then begin print('Replace:'); saveline:=false; lc:=lc-1; end;
  155.     if ti='/EX' then begin exit:=true; saveline:=false; end;
  156.     if ti='/ES' then begin exit:=true; save:=true; saveline:=false; end;
  157.     if ti='/C:' then begin
  158.       i:=copy(i,4,length(i)-3);
  159.       if i[length(i)]<>#1 then i:=i+#1;
  160.       i:=#2+i;
  161.     end;
  162.     if (ti='/T:') and (maxli-lc>2) then begin
  163.       i:=copy(i,4,length(i)-3);
  164.       if i[length(i)]=#1 then i:=copy(i,1,length(i)-1);
  165.       li[lc]:=#2+'+-'+copy(filler,1,length(i))+'-+'+#1;
  166.       li[lc+1]:=#2+'! '+i+' !'+#1;
  167.       li[lc+2]:=li[lc];
  168.       saveline:=false; lc:=lc+3;
  169.     end;
  170.     if ti='/AB' then if upcase(i[4])='T'then begin
  171.       exit:=true; abortit:=true; saveline:=false; end;
  172.     if ti='/CL' then if upcase(i[4])='R' then begin
  173.       saveline:=false; lc:=1;
  174.       print('Message cleared.... Start over...');
  175.     end;
  176.     if ti='/HE' then begin
  177.       print('/ES = immediate save');
  178.       print('/EX = exit and edit');
  179.       print('/ABT = abort');
  180.       print('/CLR = clear message');
  181.       print('/LI = list so far');
  182.       print('/RL = replace last line');
  183.       print('/C: = center rest of line');
  184.       print('/T: = boxed title');
  185.       saveline:=false;
  186.     end;
  187.     if ti='/LI' then begin
  188.       prompt('With line numbers? '); if yn then listit(true) else listit(false);
  189.     end;
  190.     if saveline then begin li[lc]:=i; lc:=lc+1; if lc>maxli then exit:=true;
  191.       if lc+4=maxli then print('=5 lines left =');
  192.     end;
  193.   until exit or hangup;
  194.   if hangup then abortit:=true;
  195.   if (not abortit) and (not save) then
  196.   repeat
  197.     prompt('S,L,A,C,R,I,D,? :'); ONEK(c,'SLACRID?');
  198.     case c of
  199.       'L':begin prompt('With line numbers? '); if yn then listit(true) else listit(false); end;
  200.       'D':begin
  201.             prompt('Line number to delete (1-'+cstr(lc-1)+')? ');
  202.             input(i,4);t:=value(i); if (t>0) and (t<lc) then begin
  203.               for t1:=t to lc-2 do li[t1]:=li[t1+1]; lc:=lc-1;
  204.             end;
  205.           end;
  206.       'R':begin
  207.             prompt('Line number to replace (1-'+cstr(lc-1)+')? ');
  208.             input(i,4);t:=value(i); if (t>0) and (t<lc) then begin
  209.               print('Old line:'); print(li[t]); print('Enter new line:');
  210.               inli(i); if (li[t][length(li[t])]=#1) and (i[length(i)]<>#1) then
  211.                 li[t]:=i+#1 else li[t]:=i;
  212.             end;
  213.           end;
  214.       'I':begin
  215.             prompt('Line number to insert before (1-'+cstr(lc-1)+')? ');
  216.             input(i,4); t:=value(i); if (t>0) and (t<lc) then begin
  217.               for t1:=lc downto t+1 do li[t1]:=li[t1-1]; lc:=lc+1;
  218.               print('New line:'); inli(li[t]);
  219.             end;
  220.           end;
  221.       'A':begin
  222.             prompt('Abort? ');
  223.             if yn then abortit:=true else c:=' ';
  224.           end;
  225.       'S':save:=true;
  226.       'C':if lc>maxli then begin print('Too long.'); c:=' '; end else
  227.             print('Continue...');
  228.       '?':begin
  229.             print('S:ave         L:ist');
  230.             print('A:bort        C:ontinue');
  231.             print('R:eplace line I:nsert line');
  232.             print('D:elete line  ?:this');
  233.           end;
  234.     end;
  235.   until (c='S') or (c='A') or (c='C') or hangup;
  236.  until abortit or save or hangup;
  237.  if lc=1 then begin abortit:=true; save:=false; end;
  238.  if save then begin
  239.    case an of
  240.      no      : ti:=nam;
  241.      forced  : ti:='@'+nam;
  242.      yes     : begin
  243.                  prompt('Anonymous? ');
  244.                  if yn then ti:='@'+nam else ti:=nam;
  245.                end;
  246.      dearabby: begin repeat
  247.                  nl;print('Post as:'); print('1. Abby');
  248.                  print('2. Problemed Person'); print('3. '+nam);
  249.                  nl;prompt('Which? '); onek(c,'123');
  250.                 until (c in ['1'..'3']) or hangup;
  251.                 case c of
  252.                  '1': ti:='+'+nam;
  253.                  '2': ti:='-'+nam;
  254.                  '3': ti:=nam;
  255.                 end;
  256.                end;
  257.    end;
  258.    if ti=nam then lan:=false else lan:=true;
  259.    print('Saving...');
  260.    while (lc>1) and ((li[lc-1]='') or (li[lc-1]=chr(10))) do lc:=lc-1;
  261.    mrec:=systat.hmsg; mrec.number:=mrec.number+1; if mrec.number=-32767 then
  262.      mrec.ltr:=succ(mrec.ltr);
  263.    if mrec.ltr>'Z' then begin
  264.      mrec.ltr:='A';
  265.      mrec.ext:=mrec.ext+1;
  266.      if mrec.ext>=128 then mrec.ext:=1;
  267.    end;
  268.    systat.hmsg:=mrec;
  269.    if mp then mrec.ext:=mrec.ext+128;
  270.    i:=filename(mrec);
  271.    assign(filvar,i);
  272.    rewrite(filvar);
  273.    writeln(filvar,ti); ti:=dat; writeln(filvar,ti);
  274.    if irt<>'' then begin
  275.      writeln(filvar,'RE: '+irt);
  276.      writeln(filvar); writeln(filvar); writeln(filvar);
  277.    end;
  278.    for t:=1 to lc-1 do
  279.      writeln(filvar,li[t]);
  280.    close(filvar); reset(systatf); write(systatf,systat); close(systatf);
  281.  end else begin print('Aborted.'); mrec.ext:=0; end;
  282.  end else begin print('Aborted.'); mrec.ext:=0; end;
  283. end;
  284.  
  285. procedure readmsg(mrec:messages;rname:boolean; var next:boolean);
  286. var f,n,rn,d:str; filvar:text; abort:boolean;
  287. begin
  288.   lastname:='';
  289.   f:=filename(mrec); rn:='';
  290.   if cs then print('Filename: '+f);
  291.   assign(filvar,f); {$I-} reset(filvar); {$I+}
  292.   if ioresult<>0 then print('File not found.') else
  293.   if (not hangup) then begin
  294.     readln(filvar,n);
  295.     readln(filvar,d); lastname:=n;
  296.     if n[1]='@' then if rname then n:='<<< '+copy(n,2,length(n)-1)+' >>>'
  297.       else begin lastname:=''; n:='>UNKNOWN<'; d:='<-> INACTIVE <->'; END;
  298.     IF (N[1]='+') or (n[1]='-') then begin
  299.       rn:=copy(n,2,length(n)-1);
  300.       if n[1]='+' then n:='Abby' else n:='Problemed Person';
  301.       if not rname then begin d:='<-> INACTIVE <->'; rn:=''; lastname:=''; end;
  302.     end;
  303.     abort:=false;
  304.     printacr('Name: '+n,abort,next); if not abort then begin
  305.       if  rn<>'' then print('Name: '+rn);
  306.       printacr('Date: '+d,abort,next); nl;
  307.       while (not abort) and (not eof(filvar)) do begin
  308.         readln(filvar,n); printa(n,abort,next);
  309.       end;
  310.       if not abort then nl;
  311.     end;
  312.   end;
  313.   close(filvar); nl;
  314. end;
  315.